home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
pascal
/
totsrc11.zip
/
TOTLINK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-05-04
|
35KB
|
1,247 lines
{ Copyright 1991 TechnoJock Software, Inc. }
{ All Rights Reserved }
{ Restricted by License }
{ Build # 1.10 }
Unit totLINK;
{$I TOTFLAGS.INC}
{
Development Notes:
1.00a Apr 2 91 Changed file read logic when only Directory
requested in FileDLLOBJ.
1.00b May 29 91 Corrected DelNode when nil pointer passed
1.00c Jun 11 91 Allowed display of directories when mask <> '*.*'
1.00d Oct 10 91 Reset vSorted when list modified
}
INTERFACE
Uses DOS,CRT,
totSTR;
Const
NoFiles: string[20] = 'No Files';
Type
tFileInfo = record
FileName: string[12];
Attr: byte;
Time: longint;
Size: longint;
LoadID: longint;
end; {tFileInfo}
DLLNodePtr = ^DLLNodeObj;
pDLLNodeOBJ = ^DLLNodeOBJ;
DLLNodeOBJ = Object {this object is not extensible}
vNextPtr: DLLNodePtr;
vPrevPtr: DLLNodePtr;
vDataPtr: pointer;
vSize: longint;
vStatus: byte; {selectable, selected}
{methods...}
procedure FreeData;
function NextPtr: DLLNodePtr;
function PrevPtr: DLLNodePtr;
function GetStatus(BitPos:byte): boolean;
procedure SetStatus(BitPos:byte;On:boolean);
function GetStatusByte: byte;
procedure SetStatusByte(Val:byte);
end; {DLLNodeOBJ}
DLLPtr = ^DLLOBJ;
pDLLOBJ = ^DLLOBJ;
DLLOBJ = Object
vStartNodePtr: DLLNodePtr;
vEndNodePtr: DLLNodePtr;
vActiveNodePtr: DLLNodePtr;
vTotalNodes: longint;
vActiveNodeNumber: longint;
vSortID: shortInt;
vSortAscending: boolean;
vSorted: boolean;
vMaxNodeSize : longint;
{methods...}
constructor Init;
function Add(var TheData;Size:longint): integer;
function Change(Node:DLLNodePtr;var TheData;Size:longint): integer;
function InsertBefore(Node:DLLNodePtr;var TheData;Size:longint): integer;
procedure Get(var TheData);
procedure GetNodeData(Node:DLLNodePtr;Var TheData);
function GetNodeDataSize(Node:DLLNodePtr):longint;
function GetMaxNodeSize: longint;
procedure Advance(Amount:longint);
procedure Retreat(Amount:longint);
function NodePtr(NodeNumber:longint): DLLNodePtr;
procedure Jump(NodeNumber:longint);
procedure ShiftActiveNode(NewNode: DLLNodePtr; NodeNumber: longint);
procedure DelNode(Node:DLLNodePtr);
procedure DelAllStatus(BitPos:byte;On:boolean);
function TotalNodes: longint;
function ActiveNodeNumber: longint;
function ActiveNodePtr: DLLNodePtr;
function StartNodePtr: DLLNodePtr;
function EndNodePtr: DLLNodePtr;
procedure EmptyList;
procedure Sort(SortID:shortint;Ascending:boolean);
function WrongOrder(Node1,Node2:DLLNodePtr;Asc:boolean): boolean; VIRTUAL;
procedure SwapNodes(Node1,Node2:DLLNodePtr); VIRTUAL;
function GetStr(Node:DLLNodePtr;Start,Finish: longint):string; VIRTUAL;
destructor Done;
end; {DLLOBJ}
StrDLLPtr = ^StrDLLOBJ;
pStrDLLOBJ = ^StrDLLOBJ;
StrDLLOBJ = object (DLLOBJ)
{methods ...}
constructor Init;
function Add(Str:string): integer;
function Change(Node:DLLNodePtr;Str: string): integer;
function InsertBefore(Node:DLLNodePtr;Str:string): integer;
function WrongOrder(Node1,Node2:DLLNodePtr;Asc:boolean): boolean; VIRTUAL;
function GetStr(Node:DLLNodePtr;Start,Finish: longint):string; VIRTUAL;
destructor Done;
end; {StrDLLOBJ}
FileDLLPtr = ^FileDLLOBJ;
pFileDLLOBJ = ^FileDLLOBJ;
FileDLLOBJ = object (DLLOBJ)
vFileMasks: string;
vFileAttrib: word;
{methods ...}
constructor Init;
procedure FillList;
procedure SetFileDetails(FileMasks:string; FileAttrib: word);
procedure FillNewMask(FileMasks:string);
function GetLongStr(Node:DLLNodePtr):string;
procedure GetFileRecord(var FileInfo:tFileInfo; Item:longint);
function GetFileMask:string;
function WrongOrder(Node1,Node2:DLLNodePtr;Asc:boolean): boolean; VIRTUAL;
procedure SwapNodes(Node1,Node2:DLLNodePtr); VIRTUAL;
function GetStr(Node:DLLNodePtr;Start,Finish: longint):string; VIRTUAL;
destructor Done;
end; {FileDLLOBJ}
function Subdirectory(B : byte):boolean;
function FileAttribs(B:byte):string;
function LongName(Info: tFileInfo):string;
procedure LINKInit;
IMPLEMENTATION
{|||||||||||||||||||||||||||||||||||||||||||||}
{ }
{ M i s c. P r o c s & F u n c s }
{ }
{|||||||||||||||||||||||||||||||||||||||||||||}
function Subdirectory(B : byte):boolean;
begin
Subdirectory := ((B and Directory) = Directory);
end; {Subdirectory}
function FileAttribs(B:byte):string;
var
S : string;
begin
S := ' ';
If ((B and ReadOnly) = Readonly) then
S[1] := 'R';
If ((B and Hidden) = Hidden) then
S[2] := 'H';
If ((B and SysFile) = SysFile) then
S[3] := 'S';
If ((B and Archive) = Archive) then
S[4] := 'A';
FileAttribs := S;
end; {FileAttribs}
function LongName(Info: tFileInfo):string;
{}
var
DT :datetime;
S: String;
begin
S := padleft(Info.FileName,12,' ');
UnPackTime(Info.Time,DT);
if Subdirectory(Info.Attr) then {add file size}
S := S + Padright('<DIR>',8,' ')
else
S := S + Padright(InttoStr(Info.Size),8,' ');
S := S + ' ';
with DT do
begin
Case Month of
1 : S := S + 'Jan ';
2 : S := S + 'Feb ';
3 : S := S + 'Mar ';
4 : S := S + 'Apr ';
5 : S := S + 'May ';
6 : S := S + 'Jun ';
7 : S := S + 'Jul ';
8 : S := S + 'Aug ';
9 : S := S + 'Sep ';
10: S := S + 'Oct ';
11: S := S + 'Nov ';
12: S := S + 'Dec ';
end; {case}
S := S + Padright(InttoStr(Day),2,'0')+','+IntToStr(Year)+' ';
if Hour > 12 then
S := S + Padright(IntToStr(Hour-12),2,' ')+':'+Padright(IntToStr(min),2,'0')+'p'
else
S := S + Padright(IntToStr(Hour),2,' ')+':'+Padright(IntToStr(min),2,'0')+'a';
S := S + ' '+FileAttribs(Info.Attr);
end;
LongName := S;
end; {LongName}
{||||||||||||||||||||||||||||||||||||||||||||||}
{ }
{ D L L N o d e O b j M E T H O D S }
{ }
{||||||||||||||||||||||||||||||||||||||||||||||}
procedure DLLNodeObj.FreeData;
{}
begin
if (vDataPtr <> Nil) and (vSize > 0) then
begin
Freemem(vDataPtr,vSize);
vDataPtr := nil;
vSize:= 0;
end;
end; {DLLNodeObj.FreeData}
function DLLNodeObj.NextPtr: DLLNodePtr;
{}
begin
NextPtr := vNextPtr;
end; {DLLNodeOBJ.NextPtr}
function DLLNodeObj.PrevPtr: DLLNodePtr;
{}
begin
PrevPtr := vPrevPtr;
end; {DLLNodeOBJ.PrevPtr}
function DLLNodeObj.GetStatus(BitPos:byte): boolean;
{}
var TestByte: Byte;
begin
if BitPos > 7 then
GetStatus := false
else
begin
Testbyte := vStatus;
TestByte := TestByte SHR BitPos; {move to end bit}
GetStatus := odd(TestByte);
end;
end; {DLLNodeOBJ.GetStatus}
procedure DLLNodeObj.SetStatus(BitPos:byte; On:boolean);
{}
var
Test : integer;
begin
if BitPos <= 7 then
begin
if On then
begin
Test := 1 SHL BitPos;
vStatus := vStatus or Test
end
else
begin
Test := not (1 SHL BitPos);
vStatus := vStatus and Test;
end;
end;
end; { DLLNodeObj.SetStatus }
function DLLNodeObj.GetStatusByte: byte;
{}
begin
GetStatusByte := vStatus;
end; {DLLNodeObj.GetStatusByte}
procedure DLLNodeObj.SetStatusByte(Val:byte);
{}
begin
vStatus := Val;
end; {DLLNodeObj.SetStatusByte}
{||||||||||||||||||||||